home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / Visual Database / Visual BASIC 5.0 (Ent. Edition) / Vb5ent Extractor.EXE / VB / SAMPLES / PGUIDE / PROGWOB / PWOSTICK.FRM (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1996-11-26  |  6.7 KB  |  216 lines

  1. VERSION 5.00
  2. Begin VB.Form frmSticks 
  3.    Caption         =   "Employees Collection - House of Sticks"
  4.    ClientHeight    =   3525
  5.    ClientLeft      =   1140
  6.    ClientTop       =   1515
  7.    ClientWidth     =   4995
  8.    LinkTopic       =   "Form1"
  9.    LockControls    =   -1  'True
  10.    PaletteMode     =   1  'UseZOrder
  11.    ScaleHeight     =   3525
  12.    ScaleWidth      =   4995
  13.    Begin VB.CommandButton cmdTrouble 
  14.       Caption         =   "&Trouble"
  15.       Height          =   465
  16.       Left            =   3150
  17.       TabIndex        =   8
  18.       Top             =   2250
  19.       Width           =   1545
  20.    End
  21.    Begin VB.CommandButton cmdClose 
  22.       Caption         =   "&Close"
  23.       Height          =   285
  24.       Left            =   3150
  25.       TabIndex        =   9
  26.       Top             =   2880
  27.       Width           =   1545
  28.    End
  29.    Begin VB.CommandButton cmdListEmployees 
  30.       Caption         =   "&Refresh List"
  31.       Height          =   285
  32.       Left            =   3150
  33.       TabIndex        =   7
  34.       Top             =   1800
  35.       Width           =   1545
  36.    End
  37.    Begin VB.CommandButton cmdDeleteEmployee 
  38.       Caption         =   "&Delete"
  39.       Height          =   285
  40.       Left            =   3150
  41.       TabIndex        =   6
  42.       Top             =   1440
  43.       Width           =   1545
  44.    End
  45.    Begin VB.CommandButton cmdAddEmployee 
  46.       Caption         =   "&Add"
  47.       Default         =   -1  'True
  48.       Enabled         =   0   'False
  49.       Height          =   285
  50.       Left            =   3150
  51.       TabIndex        =   5
  52.       Top             =   1080
  53.       Width           =   1545
  54.    End
  55.    Begin VB.ListBox lstEmployees 
  56.       Height          =   1845
  57.       Left            =   180
  58.       TabIndex        =   4
  59.       Top             =   1080
  60.       Width           =   2715
  61.    End
  62.    Begin VB.TextBox txtSalary 
  63.       Height          =   285
  64.       Left            =   2700
  65.       TabIndex        =   3
  66.       Top             =   450
  67.       Width           =   1995
  68.    End
  69.    Begin VB.TextBox txtName 
  70.       Height          =   285
  71.       Left            =   180
  72.       TabIndex        =   1
  73.       Top             =   450
  74.       Width           =   2265
  75.    End
  76.    Begin VB.Label Label2 
  77.       Caption         =   "&Salary"
  78.       Height          =   195
  79.       Left            =   2700
  80.       TabIndex        =   2
  81.       Top             =   180
  82.       Width           =   2025
  83.    End
  84.    Begin VB.Label Label1 
  85.       Caption         =   "&Name"
  86.       Height          =   195
  87.       Left            =   180
  88.       TabIndex        =   0
  89.       Top             =   180
  90.       Width           =   2265
  91.    End
  92. Attribute VB_Name = "frmSticks"
  93. Attribute VB_GlobalNameSpace = False
  94. Attribute VB_Creatable = False
  95. Attribute VB_PredeclaredId = True
  96. Attribute VB_Exposed = False
  97. Option Explicit
  98. Public sbMain As New SmallBusiness2
  99. Private Sub cmdAddEmployee_Click()
  100.     Dim empNew As Employee
  101.     If Not IsNumeric(txtSalary) Then
  102.         MsgBox "Salary is not a valid amount."
  103.         ' Set focus on salary field, and
  104.         '   select all text.
  105.         With txtSalary
  106.             .SetFocus
  107.             .SelStart = 0
  108.             .SelLength = Len(.Text)
  109.         End With
  110.         Exit Sub
  111.     End If
  112.     Set empNew = sbMain.AddEmployee(txtName.Text, txtSalary.Text)
  113.     With empNew
  114.         lstEmployees.AddItem .ID & ", " & .Name & ", " & .Salary
  115.     End With
  116.     With lstEmployees
  117.         ' Select the newly added item.
  118.         .ListIndex = .NewIndex
  119.     End With
  120.     txtName.Text = ""
  121.     txtSalary.Text = ""
  122.     txtName.SetFocus
  123. End Sub
  124. Private Sub cmdClose_Click()
  125.     Unload Me
  126. End Sub
  127. Private Sub cmdDeleteEmployee_Click()
  128.     Dim lngDeletedItem As Long
  129.     With lstEmployees
  130.         lngDeletedItem = .ListIndex
  131.         ' Check to make sure there is an employee selected.
  132.         If .ListIndex > -1 Then
  133.             ' The employee ID is the first six characters on the line.
  134.             sbMain.DeleteEmployee Left(lstEmployees.Text, 6)
  135.             ' Remove the selected item.
  136.             .RemoveItem .ListIndex
  137.             If .ListCount = 0 Then
  138.                 ' If the list is now empty,
  139.                 '   don't attempt to set a new
  140.                 '   selection.
  141.                 Exit Sub
  142.             End If
  143.             ' Was the deleted item at the very bottom of
  144.             '   the list box?  If so, its index wil be
  145.             '   greater than or equal to the list count...
  146.             If .ListCount <= lngDeletedItem Then
  147.                 '   ...so set the current selection to
  148.                 '   the new bottom item...
  149.                 .ListIndex = lngDeletedItem - 1
  150.             Else
  151.                 '   ...otherwise, keep the selection in
  152.                 '   the same physical position in the
  153.                 '   list.
  154.                 .ListIndex = lngDeletedItem
  155.             End If
  156.         Else
  157.             MsgBox "No employee selected."
  158.         End If
  159.     End With
  160. End Sub
  161. Private Sub cmdListEmployees_Click()
  162.     Dim lngCt As Long
  163.     Dim emp As Employee
  164.     With lstEmployees
  165.         .Clear
  166.         For lngCt = 1 To sbMain.EmployeeCount
  167.             Set emp = sbMain.Employees(lngCt)
  168.             .AddItem emp.ID & ", " & emp.Name & ", " & emp.Salary
  169.         Next lngCt
  170.         If .ListCount <> 0 Then
  171.             ' If there are any items in the list,
  172.             '   select the first.
  173.             .ListIndex = 0
  174.         End If
  175.     End With
  176. End Sub
  177. Private Sub cmdTrouble_Click()
  178.     ' While the private Collection object
  179.     '   protects against random objects
  180.     '   being added to the collection, an
  181.     '   internal coding error in the
  182.     '   SmallBusiness2 object can still
  183.     '   cause problems.
  184.     sbMain.Trouble
  185.     MsgBox "An internal coding error in SmallBusiness2 has added an uninitialized Employee to the collection.  To see the problem this causes, press Refresh List."
  186. End Sub
  187. Private Sub Form_Unload(Cancel As Integer)
  188.     ' Set the hidden global variable for
  189.     '   this form to Nothing, to release
  190.     '   its resources.
  191.     Set frmSticks = Nothing
  192. End Sub
  193. Private Sub txtName_Change()
  194.     Call EnableAddButton
  195. End Sub
  196. Private Sub txtSalary_Change()
  197.     Call EnableAddButton
  198. End Sub
  199. Private Sub txtSalary_KeyPress(KeyAscii As Integer)
  200.     Select Case KeyAscii
  201.         Case 48 To 57   ' Allow digits
  202.         Case 8      ' Allow backspace
  203.         Case 46     ' Allow period
  204.         Case Else
  205.             KeyAscii = 0
  206.             Beep
  207.     End Select
  208. End Sub
  209. Private Sub EnableAddButton()
  210.     If (Len(txtName) > 0) And (Len(txtSalary) > 0) Then
  211.         cmdAddEmployee.Enabled = True
  212.     Else
  213.         cmdAddEmployee.Enabled = False
  214.     End If
  215. End Sub
  216.